home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: delta / whiteline CD Series - delta.iso / progtool / modula2 / module / winicon.mod < prev    next >
Encoding:
Modula Implementation  |  1995-11-25  |  2.5 KB  |  89 lines
  1. IMPLEMENTATION MODULE  WinIcon;
  2.  
  3. FROM SYSTEM IMPORT ADDRESS,VAL;
  4.  
  5. FROM AES IMPORT WindowCalc,FormCenter,ObjectDraw,WindowGet;
  6.  
  7. FROM GEMAESBase IMPORT WorkXYWH,CurrXYWH,WCBorder;
  8. FROM EasyDialog IMPORT GetObjectXYWH,SetObjectXYWH;
  9. FROM EasyWindow IMPORT WindowElements,windowlist,createWindow,openWindow,
  10.                        rectangle,windowtype,setWindow,RedrawProcType;
  11.  
  12. PROCEDURE InstallIcon( Window : INTEGER; r : rectangle);
  13. VAR x,y,w,h : INTEGER;
  14.     win : windowtype;
  15. BEGIN
  16.   IF (windowlist[Window]#NIL) THEN
  17.     win:=windowlist[Window]^;
  18.     IF win.opened THEN
  19.        GetObjectXYWH(0,win.reference,VAL(CARDINAL,x),VAL(CARDINAL,y),VAL(CARDINAL,w),VAL(CARDINAL,h));
  20.        SetObjectXYWH(0,win.reference,win.work.x+1,win.work.y+1,w,h);
  21.        ObjectDraw(win.reference,0,8,r.x,r.y,r.w,r.h);
  22.     END(*IF*);
  23.   END(*IF*);
  24. END InstallIcon;
  25.  
  26. PROCEDURE CreateIconWindow(TreePtr: ADDRESS; Title : ARRAY OF CHAR; x,y,w,h:INTEGER;
  27.                            RedrawProc :RedrawProcType;
  28.                            Elements : WindowElements):INTEGER;
  29. VAR Icx,Icy,Icw,Ich :INTEGER;
  30.     xb,yb,hb,wb:INTEGER;
  31.     dx,dy,dw,dh:INTEGER;
  32.     Window :INTEGER;
  33.     win : windowtype;
  34. BEGIN
  35.     FormCenter(TreePtr,Icx,Icy,Icw,Ich);
  36.     WindowGet(0,WorkXYWH,dx,dy,dw,dh);
  37.     createWindow(Window,x,y,w,h,Elements,Title,TRUE,RedrawProc);
  38.     IF dx>x THEN
  39.         x:=dx;
  40.     END(*IF*);
  41.     IF dy>y THEN
  42.         y:=dy;
  43.     END(*IF*);
  44.     IF (Icw>w) THEN
  45.         w:=Icw;
  46.     END(*IF*);
  47.     IF Ich>h THEN
  48.         h:=Ich;
  49.     END(*IF*);
  50.     IF (windowlist[Window]#NIL) THEN
  51.          win:=windowlist[Window]^;
  52.          WindowCalc(WCBorder,VAL(INTEGER,Elements),x,y,w,h,xb,yb,wb,hb);
  53.          win.min.x:=xb;
  54.          win.min.y:=yb;
  55.          win.min.w:=wb;
  56.          win.min.h:=hb;
  57.          win.snap:=TRUE;
  58.          win.reference:=TreePtr;
  59.          windowlist[Window]^:=win;
  60.     END(*IF*);
  61.     RETURN Window
  62. END  CreateIconWindow;
  63.  
  64. PROCEDURE OpenIconWindow(Window,x,y,w,h:INTEGER);
  65. VAR r :rectangle;
  66.     win : windowtype;
  67.     dx,dy,dw,dh:INTEGER;
  68.  
  69. BEGIN
  70.     WindowGet(0,WorkXYWH,dx,dy,dw,dh);
  71.     IF dx>x THEN
  72.         x:=dx;
  73.     END(*IF*);
  74.     IF dy>y THEN
  75.         y:=dy;
  76.     END(*IF*);
  77.  
  78.     IF (windowlist[Window]#NIL) THEN
  79.        win:=windowlist[Window]^;
  80.        IF w<win.min.w THEN w:=win.min.w END(*IF*);
  81.        IF w<win.min.h THEN w:=win.min.h END(*IF*);
  82.        openWindow(Window,x,y,w,h);
  83.        r.x:=x;r.y:=y;r.h:=h;r.w:=w;
  84.        InstallIcon(Window,r);
  85.     END(*IF*);
  86. END  OpenIconWindow;
  87.  
  88. END WinIcon.
  89.